home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / pcmagwin.zip / GROUPMEN.PAS < prev    next >
Pascal/Delphi Source File  |  1992-09-25  |  11KB  |  336 lines
  1. {$D-,L-,R-,S-,W-}
  2. PROGRAM GroupMenu;
  3. USES WinTypes, WinProcs, Strings, ShellApi, WinDos,
  4.   StdDlgs, GroupType, GroupFile,
  5. {$IFDEF VER70}
  6.   ODialogs, OWindows, Objects;
  7.   {$Q-}
  8. {$ELSE}
  9.   WObjects;
  10. {$ENDIF}
  11. {$D Copyright (c) 1992 by Neil J. Rubenking}
  12. {$R GROUPMEN.RES}
  13. {$I GROUPMEN.INC}
  14. CONST
  15.   AppName : PChar = 'GroupMenu';
  16. TYPE
  17.   TMyApplication = OBJECT(TApplication)
  18.     PROCEDURE InitMainWindow; virtual;
  19.   END;
  20.  
  21.   PNStrCollection = ^TNStrCollection;
  22.   TNStrCollection = OBJECT(TStrCollection)
  23.     {Just like a TStrCollection, but strings aren't sorted}
  24.     FUNCTION Compare(Key1, Key2 : Pointer) : Integer; Virtual;
  25.   END;
  26.  
  27.   PGroupMWindow = ^TGroupMWindow;
  28.   TGroupMWindow = OBJECT(TWindow)
  29.     Commands : PNStrCollection;
  30.     CONSTRUCTOR Init(AParent : PWindowsObject; AName : PChar);
  31.     PROCEDURE SetUpWindow; Virtual;
  32.     DESTRUCTOR Done; Virtual;
  33.     FUNCTION GetClassName : PChar; Virtual;
  34.     PROCEDURE GetWindowClass(var AWndClass: TWndClass); Virtual;
  35.     PROCEDURE wmCommand(VAR Msg : TMessage); Virtual
  36.       wm_First + wm_Command;
  37.     PROCEDURE JustMenu(Wid : Word);
  38.   END;
  39.  
  40.   FUNCTION TNStrCollection.Compare(Key1, Key2 : Pointer) : Integer;
  41.   BEGIN Compare := -1; END;
  42.  
  43. {--------------------------------------------------}
  44. { TGroupMWindow's methods                          }
  45. {--------------------------------------------------}
  46.   CONSTRUCTOR TGroupMWindow.Init(AParent : PWindowsObject;
  47.     AName : PChar);
  48.   CONST
  49.     Groupx   : PChar = 'GROUP99';
  50.   VAR
  51.     N, Item  : Word;
  52.     T        : TGroupFile;
  53.     TID      : TItemData;
  54.     SubH     : hMenu;
  55.     Buff     : ARRAY[0..80] OF Char;
  56.     HotBuff,
  57.     CmdBuff,
  58.     itemBuff : ARRAY[0..144] OF Char;
  59.  
  60.     FUNCTION InsertMenuAlpha(Menu: HMenu; Flags, IDNewItem: Word;
  61.       NewItem: PChar): Bool;
  62.       {Insert the item into menu in alpha order}
  63.     VAR
  64.       Posn, NumItems : Integer;
  65.       found          : Boolean;
  66.       mbuff          : ARRAY[0..80] OF Char;
  67.     BEGIN
  68.       Posn := 0;
  69.       NumItems := GetMenuItemCount(Menu);
  70.       found := FALSE;
  71.       IF NumItems > 0 THEN
  72.         WHILE (Posn < NumItems) AND (NOT found) DO
  73.           BEGIN
  74.             GetMenuString(Menu, Posn, mbuff, 80, MF_BYPOSITION);
  75.             IF StrIComp(NewItem, mbuff) < 0 THEN found := TRUE
  76.             ELSE Inc(Posn);
  77.           END;
  78.       InsertMenuAlpha := InsertMenu(Menu, Posn, Flags, IDNewItem,
  79.         NewItem);
  80.     END;
  81.  
  82.   BEGIN
  83.     TWindow.Init(AParent, AName);
  84.     New(Commands, Init(8, 8));
  85.     Attr.Menu := LoadMenu(hInstance, AppName);
  86.     FOR N := 1 TO 40 DO {max of 40 groups}
  87.       BEGIN
  88.         wvsprintf(Groupx, 'Group%u', N);
  89.         GetPrivateProfileString('Groups', Groupx, '', Buff, 80,
  90.           'PROGMAN.INI');
  91.         IF Buff[0] <> #0 THEN
  92.           BEGIN
  93.             {Buff holds FILENAME of Nth group}
  94.             T.Init(Buff);
  95.             IF T.GetStatus <> msg_Ok THEN
  96.               MessageBox(hWindow, T.GetStatStr(itemBuff, 144),
  97.                 Buff, mb_Ok + mb_IconInformation)
  98.             ELSE
  99.               BEGIN
  100.                 T.fpName(buff, 80); {buff now holds name of group}
  101.                 SubH := CreateMenu;
  102.                 FOR Item := 0 TO T.fcItems-1 DO
  103.                   IF T.GetNthItem(Item, TID) THEN
  104.                     BEGIN
  105.                       T.PCharFmOffset(TID.pName, itembuff, 80);
  106.                       IF T.GetItemTagHotStr(Item, Hotbuff, 80) THEN
  107.                         BEGIN
  108.                           StrLCat(itemBuff, '{', 144);
  109.                           StrLCat(itemBuff, HotBuff, 144);
  110.                           StrLCat(itemBuff, '}', 144);
  111.                         END;
  112.  
  113.                       IF NOT T.GetItemTagDir(Item, cmdBuff+1, 144) THEN
  114.                         StrCopy(cmdBuff, '*');
  115.                       IF T.GetItemTagMin(Item) THEN cmdBuff[0] := 'm'
  116.                       ELSE cmdBuff[0] := 'M';
  117.                       StrLCat(cmdBuff, ' ', 144);                      
  118.                       T.PCharFmOffset(TID.pCommand, StrEnd(Cmdbuff),
  119.                         144-StrLen(CmdBuff));
  120.                         {add program name to submenu, in order}
  121.                       InsertMenuAlpha(SubH, MF_STRING +
  122.                         MF_BYPOSITION, commands^.Count+cm_Progs,
  123.                         itemBuff);
  124.                         {add command info to collection}
  125.                       commands^.Insert(StrNew(CmdBuff));
  126.                     END;
  127.                   {add submenu to main menu, in order}
  128.                 InsertMenuAlpha(Attr.Menu, MF_POPUP + MF_BYPOSITION,
  129.                   SubH, buff);
  130.                 T.Done;
  131.               END;
  132.           END;
  133.       END;
  134.   END;
  135.  
  136.   PROCEDURE TGroupMWindow.SetUpWindow;
  137.   BEGIN
  138.     TWindow.SetUpWindow;
  139.     JustMenu(GetSystemMetrics(sm_CXScreen));
  140.   END;
  141.  
  142.   DESTRUCTOR TGroupMWindow.Done;
  143.   BEGIN
  144.     Dispose(Commands, Done);
  145.     TWindow.Done;
  146.   END;
  147.  
  148.   FUNCTION TGroupMWindow.GetClassName;
  149.   BEGIN
  150.     GetClassName := AppName;
  151.   END;
  152.  
  153.   PROCEDURE TGroupMWindow.GetWindowClass(VAR AWndClass :
  154.     TWndClass);
  155.   BEGIN
  156.     TWindow.GetWindowClass(AWndClass);
  157.     AWndClass.hIcon := LoadIcon(HInstance, AppName);
  158.   END;
  159.  
  160.   PROCEDURE TGroupMWindow.wmCommand(VAR Msg : TMessage);
  161.  
  162.     PROCEDURE ExecuteProgram(Num : Word);
  163.       {GRP file contains program name prefixed with *working*
  164.         directory (if specified).  Actual directory containing
  165.         program is stored in tag data}
  166.     VAR
  167.       ProgDir  : ARRAY[0..fsPathName]  OF Char;
  168.       DefDir   : ARRAY[0..fsDirectory] OF Char;
  169.       ProgName : ARRAY[0..fsFileName]  OF Char;
  170.       ProgExt  : ARRAY[0..fsExtension] OF Char;
  171.       CmdLine  : ARRAY[0..127] OF Char;
  172.       P1, P2   : PChar;
  173.       ShowCmd  : Integer;
  174.     BEGIN
  175.       P1 := commands^.At(Num);
  176.       IF P1[0] = 'm' THEN ShowCmd := sw_ShowMinimized
  177.       ELSE ShowCmd := sw_ShowNormal;
  178.       IF P1[1] = '*' THEN
  179.         BEGIN
  180.           ProgDir[0] := #0;
  181.           P2 := P1 + 3;
  182.         END
  183.       ELSE
  184.         BEGIN
  185.           P2 := StrScan(P1+1, ' ')+1;
  186.           StrLCopy(ProgDir, P1+1, P2-P1-2);
  187.         END;
  188.       FileSplit(P2, DefDir, ProgName, ProgExt);
  189.       StrCat(ProgDir, ProgName);
  190.       StrCat(ProgDir, ProgExt);
  191.       P1 := StrScan(P2, ' ');
  192.       IF P1 = NIL THEN CmdLine[0] := #0
  193.       ELSE StrCopy(CmdLine, P1+1);
  194.       IF ShellExecute(hWindow, NIL, ProgDir, CmdLine,
  195.         DefDir, ShowCmd) <= 32 THEN
  196.         MessageBox(hWindow, ProgDir, 'CANNOT EXECUTE',
  197.           mb_Ok + mb_IconStop);
  198.     END;
  199.  
  200.     PROCEDURE FindFile;
  201.     CONST
  202.       Partl : ARRAY[0..80] OF Char = '';
  203.     VAR
  204.       MainB, SubB : ARRAY[0..80] OF Char;
  205.       fmt         : ARRAY[0..1] OF PChar;       
  206.       MainH, SubH : hMenu;
  207.       MsgLen,
  208.       MainN, SubN,
  209.       MainI, SubI : Word;
  210.       DidIt, Quit : Boolean;
  211.       MsgBuff     : PChar;
  212.     BEGIN
  213.       IF Application^.ExecDialog(New(PInputDialog,
  214.         Init(@Self, 'Find program', 'Partial name',
  215.         partl, 80))) <> idOK THEN Exit;
  216.       MainH := GetMenu(hWindow);
  217.       MainN := GetMenuItemCount(MainH);
  218.       DidIt := FALSE;
  219.       Quit  := FALSE;
  220.       MainI := 1;
  221.       fmt[0] := MainB;
  222.       fmt[1] := SubB;
  223.       WHILE (NOT (DidIt OR Quit)) AND (MainI < MainN) DO
  224.         BEGIN
  225.           GetMenuString(MainH, MainI, MainB, 80, MF_BYPOSITION);
  226.           SubH := GetSubMenu(MainH, MainI);
  227.           SubN := GetMenuItemCount(SubH);
  228.           SubI := 0;
  229.           WHILE (NOT (DidIt OR Quit)) AND (SubI < SubN) DO
  230.             BEGIN
  231.               GetMenuString(SubH, SubI, SubB, 80, MF_BYPOSITION);
  232.               IF StrLIComp(partl, SubB, StrLen(partl)) = 0 THEN
  233.                 BEGIN
  234.                   MsgLen :=  StrLen(MainB) + StrLen(SubB) + 20;            
  235.                   GetMem(MsgBuff, MsgLen);
  236.                   wvsprintf(MsgBuff, 'Group: %s'#13'Program: %s', fmt);
  237.                   CASE MessageBox(hWindow, MsgBuff,
  238.                     'Execute program?', mb_YesNoCancel +
  239.                       mb_IconQuestion) OF
  240.                     id_Yes    : BEGIN
  241.                                   DidIt := TRUE;
  242.                                   ExecuteProgram(GetMenuItemId(
  243.                                     SubH, SubI)-cm_Progs);
  244.                                 END;
  245.                     id_No     : ;
  246.                     id_Cancel : Quit := TRUE;
  247.                   END;
  248.                   FreeMem(MsgBuff, MsgLen);
  249.                 END;
  250.               Inc(SubI);
  251.             END;
  252.           Inc(MainI);
  253.         END;
  254.       IF NOT (DidIt OR Quit) THEN
  255.         MessageBox(hWindow, 'No more matching program names', Partl,
  256.           mb_Ok + mb_IconInformation);
  257.     END;
  258.  
  259.   BEGIN
  260.     IF Msg.lParamLo = 0 THEN
  261.       BEGIN
  262.         CASE Msg.wParam OF
  263.           cm_FileFind : FindFile;
  264.           cm_About    : Application^.ExecDialog(New(PDialog,
  265.                           Init(@Self, 'GroupAbout')));
  266.           cm_AcrossTop : BEGIN
  267.                            ShowWindow(hWindow, sw_Hide);
  268.                            JustMenu(GetSystemMetrics(sm_CXScreen));
  269.                            ShowWindow(hWindow, sw_ShowNormal);
  270.                          END;
  271.           cm_LeftSide  : BEGIN
  272.                            ShowWindow(hWindow, sw_Hide);
  273.                            JustMenu(0);
  274.                            ShowWindow(hWindow, sw_ShowNormal);
  275.                          END;
  276.           cm_Exit     : TWindow.wmCommand(Msg);
  277.           ELSE ExecuteProgram(Msg.wParam-cm_Progs);
  278.         END;
  279.       END
  280.     ELSE TWindow.wmCommand(Msg);
  281.   END;
  282.  
  283.   PROCEDURE TGroupMWindow.JustMenu(Wid : Word);
  284.   VAR
  285.     OrgH, Hig,
  286.     Hig1, MaxH : Word;
  287.     R          : TRect;
  288.   BEGIN
  289.       {Size window so nothing but complete menu is shown}
  290.     Hig1 := GetSystemMetrics(sm_CYMenu)+1;
  291.     OrgH := GetSystemMetrics(sm_CYCaption) +
  292.              2*GetSystemMetrics(sm_CYFrame)-1;
  293.     Hig  := OrgH;
  294.     MaxH := GetSystemMetrics(sm_CYScreen);
  295.     REPEAT
  296.       Inc(Hig, Hig1);
  297.       MoveWindow(hWindow, 0, 0, Wid, Hig, FALSE);
  298.       GetClientRect(hWindow, R);
  299.       IF Hig >= MaxH THEN
  300.         BEGIN
  301.           Inc(Wid, 48);
  302.           Hig := OrgH;
  303.         END;
  304.     UNTIL R.Bottom-R.Top > 0;
  305.     Dec(Hig, Hig1);
  306.     MoveWindow(hWindow, 0, 0, Wid, Hig, TRUE);
  307.   END;
  308.  
  309. {--------------------------------------------------}
  310. { TMyApplication's method implementations:         }
  311. {--------------------------------------------------}
  312.   PROCEDURE TMyApplication.InitMainWindow;
  313.   BEGIN
  314.     MainWindow := New(PGroupMWindow, Init(NIL, AppName));
  315.   END;
  316.  
  317. {--------------------------------------------------}
  318. { Main program:                                    }
  319. {--------------------------------------------------}
  320. VAR
  321.   MyApp: TMyApplication;
  322.   PrevWnd : hWnd;
  323. BEGIN
  324.   IF hPrevInst = 0 THEN
  325.     BEGIN
  326.       MyApp.Init(AppName);
  327.       MyApp.Run;
  328.       MyApp.Done;
  329.     END
  330.   ELSE
  331.     BEGIN
  332.       PrevWnd := FindWindow(AppName, AppName);
  333.       IF PrevWnd <> 0 THEN BringWindowToTop(PrevWnd);
  334.     END;
  335. END.
  336.